Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/1479/q95demo.exe/SCRIPTS.Z/MAKECIS3.QSC

Text File | 1995-11-08 | 14.8 KB | 441 lines

'
' This script is used to automatically create and add new dialing directory
' entry for Compuserve
'
'--------------------------------------------------------=[ Constants    ]=-
const WS_BORDER        = 0x00800000
const WS_VSCROLL       = 0x00200000
const WS_TABSTOP       = 0x00010000
const LB_RESETCONTENT  = 0x0184
const LB_GETTEXT       = 0x0189
const LB_SETTABSTOPS   = 0x0192
const LBS_NOTIFY       = 0x0001
const LBS_SORT         = 0x0002
const LBS_USETABSTOPS  = 0x0080
const LBS_STANDARD     = LBS_NOTIFY+WS_BORDER+WS_VSCROLL+WS_TABSTOP
const CB_GETLBTEXT     = 0x0148
const CB_RESETCONTENT  = 0x014B
const CBS_DROPDOWNLIST = 0x0003
const CBS_SORT         = 0x0100
const CBS_STANDARD     = CBS_DROPDOWNLIST+WS_VSCROLL+WS_TABSTOP

'---------------------------------------------------------------------------=[ Dialogs      ]=-
dialog Generator 5, 10, 205, 240
  caption "CompuServe Information Service"
  groupbox "User Information", -1, 10, 10, 185, 55
  rtext "Your PIN", -1, 15, 25, 50, 15
  userid as edittext 101, 70, 25, 95, 15
  rtext "Your Password", -1, 15, 45, 50, 15
  password as edittext 102, 70, 45, 95, 15

  groupbox "Connection Information",-1,10,70,185,55
  ltext "Modem",        -1, 15,85, 40, 15
  modem as combobox    106, 60,85,130, 50,
  ltext "Service",      -1, 15,105, 40, 15
  service as combobox  107, 60,105,130, 50,CBS_STANDARD

  groupbox "Phone Information",-1, 10, 135, 185,75
  pushbutton "Search Phone Database", 112, 100, 150, 90, 15
  ltext "Phone Number", -1, 15,170, 70, 15
  areacode as edittext 103,100,170, 25, 15
  number as edittext   104,130,170, 60, 15
  ltext "Country"  ,    -1, 15,190, 40, 15
  country as combobox  105, 60,190,130, 50,CBS_STANDARD+CBS_SORT

  defpushbutton "Make Script", 114, 15, 220, 50, 14
  pushbutton "Cancel", IDCANCEL, 75, 220, 50, 14
  pushbutton "About/Info", 113, 135, 220, 50, 14
end dialog

dialog phonesearch 6, 15, 310, 110
  caption "Search Phone Number List"
  ltext "Area Code",-1, 15,5,40,15
  scode as edittext 603,60,5,20,15
  ltext "Baud Rate",-1, 85,5,40,15
  srate as edittext 604,130,5,30,15
  ltext "State    ",-1,165,5,40,15
  sstate as edittext 605,210,5,20,15
  groupbox "Phone Number       City                              State      Supported Baud Rates",-1,10,20,290,65
  sresult as listbox 507,15,30,280,60,LBS_STANDARD+LBS_USETABSTOPS
  pushbutton "Cancel",IDCANCEL,100,90,50,15
  defpushbutton "Search",606,160,90,50,15
end dialog

dialog ServicesHelp 6, 15, 194, 144
  caption "About Script Generator"
  defpushbutton "OK", IDOK, 72, 122, 50, 14
  groupbox "", -1, 4, 4, 185, 111
  ltext "Compuserve Script Generator is used to automatically create a script to call compuserve.", -1, 10, 10, 170, 25
  ltext "Macro Keys are also defined with common Compuserve Functions, Use the A,AC,AS,ASC button to toggle.", -1, 10, 35, 170, 25
  ltext "Fill in PIN, Password, Area Code, Number, Country Code, Modem, and Service Type.", -1, 10, 60, 170, 25
  ltext "The search button allows you search for numbers from the Phone Number Database.", -1, 10, 85, 170, 25
end dialog

'----------------------------------------------------= Type Declarations =--
type tabrecord
  tabs(1 to 3) as integer
end type

'--------------------------------------------------------=[ Declarations ]=---
declare Sub SendDlgItemMessageText lib "user32" alias "SendDlgItemMessageA" (hwnd as integer, id as integer, message as integer, wparam as integer, lparam as string)
declare function SendDlgItemMessageInt  lib "user32" alias "SendDlgItemMessageA" (hwnd as integer, id as integer, message as integer, wparam as integer, lparam as long) as long
declare function SendDlgItemMessageTab Lib "User32" Alias "SendDlgItemMessageA" (Hwnd as integer, Id as integer, Msg as integer, Wparam as integer, lparam as TabRecord) as integer
declare function GetDlgItem lib "user32" (hwindow as integer, id as integer) as integer
declare function EnableWindow lib "user32" (hwindow as integer, on as integer) as integer

'-----------------------------------------------------------------------------=[ Variables    ]=-
dim search as phonesearch
dim searchname as string
dim readstring as string
dim n as string
dim sl as Generator
dim found as integer
dim count as integer
dim scriptname as string
dim cinfo as countryinfo

'---------------------------------------------------------------------------=[ Functions    ]=-
function GetUniqueScriptName(prefix as string) as string
  dim scrname as string
  scrname = ConfigScriptPath + "\" + prefix + ".QSC"
  dim i as integer
  i = 0
  do while exists(scrname)
    i = i + 1
    scrname = ConfigScriptPath + "\" + prefix + str(i) + ".QSC"
  loop
  GetUniqueScriptName = scrname
end function

function Generator.id(113) as integer
  dim help as ServicesHelp
  dialogbox help
end function

function Generator.id(112) as integer
  if (sl.service = 0) then searchname = ConfigScriptPath+"\cisphone.cps"
  if (sl.service = 1) then searchname = ConfigScriptPath+"\cisphone.tel"
  if (sl.service = 2) then searchname = ConfigScriptPath+"\cisphone.tym"
  if (sl.service = 3) then searchname = ConfigScriptPath+"\cisphone.dpc"
  if (sl.service = 4) then searchname = ConfigScriptPath+"\cisphone.lat"
  if (sl.areacode <> "") then search.scode = sl.areacode
  if dialogbox (search) = IDOK then
    if n <> "" then
      sl.areacode = left (n,3)
      sl.number   = mid  (n,5,8)
    end if
  end if
end function

function Generator.id(114) as integer
  dim i as integer, seencomma as integer
  for i = 1 to len(userid)
    dim c as string
    c = mid(userid, i, 1)
    if c = "," then
      if seencomma then
        msgbox "Your PIN should be in the format 12345,6789"
        exit function
      else
        seencomma = true
      end if
    elseif c < "0" or c > "9" then
      msgbox "Your PIN should be in the format 12345,6789"
      exit function
    end if
  next i
  i = instr(userid, ",")
  if i <= 1 or i >= len(userid) then
    msgbox "Your PIN should be in the format 12345,6789"
    exit function
  end if
  if password = "" then
    msgbox "You need to fill in your password."
    exit function
  end if
  if service <> 5 then
    if (number = "") or (areacode = "") then
      msgbox "Your phone number data is incomplete."
      exit function
    end if
    if (country < 0) then
      msgbox "You need to pick a country."
      exit function
    end if
  end if
  DialogResult = IDOK
  n = spc(255)
  SendDlgItemMessageText (hwindow,105,CB_GETLBTEXT,sl.country,n)
end function

function phonesearch.id(507) as integer
  n = spc(255)
  SendDlgItemMessageText (hwindow,507,LB_GETTEXT,sresult,n)
  dialogresult = IDOK
end function

function phonesearch.id(606) as integer
  dim sendmess as integer, totalfound as integer
  dim sfound as boolean

  if not ((scode = "") and (srate = "") and (sstate = "")) then
    totalfound = 0
    sendmess = SendDlgItemMessageInt (hwindow,507,LB_RESETCONTENT,0,0)
    if exists (searchname) then
      open searchname for input as #1
      do while not (eof (1))
        sfound = false
        input #1,readstring
        if (scode <> "") then
          if (srate <> "") then
            if (sstate <> "") then
              if (left (readstring,3) = scode) and (instr (mid (readstring,38,30),srate) <> 0) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (left (readstring,3) = scode) and (instr (mid (readstring,38,30),srate) <> 0) then sfound = true
            end if
          else
            if (sstate <> "") then
              if (left (readstring,3) = scode) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (left (readstring,3) = scode) then sfound = true
            end if
          end if
        else
          if (srate <> "") then
            if (sstate <> "") then
              if (instr (mid (readstring,38,30),srate) <> 0) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (instr (mid (readstring,38,30),srate) <> 0) then sfound = true
            end if
          else
            if (sstate <> "") then
              if (mid (readstring,35,2) = sstate) then sfound = true
            end if
          end if
        end if
        if sfound then
          readstring = left (readstring,12)+chr(9)+mid(readstring,14,21)+chr(9)+mid(readstring,35,2)+chr(9)+mid(readstring,38,30)
          addlistboxitem (hwindow,507,readstring)
          totalfound = totalfound + 1
          sfound = false
        end if
      loop
      close #1
    end if
    if totalfound = 0 then
      addlistboxitem (hwindow,507,"No Records Found Matching Search Criteria!")
    end if
  else
    msgbox "You must select an Area Code, Baud Rate, and/or State to search"
  end if
  scode = ""
  srate = ""
  sstate = ""
end function

function generator.id(107) as integer
  if service = 5 then
    enablewindow (getdlgitem (hwindow,112),0)
    enablewindow (getdlgitem (hwindow,103),0)
    enablewindow (getdlgitem (hwindow,104),0)
    enablewindow (getdlgitem (hwindow,105),0)
    sl.areacode = ""
    sl.number = "compuserve.com"
  else
    enablewindow (getdlgitem (hwindow,112),1)
    enablewindow (getdlgitem (hwindow,103),1)
    enablewindow (getdlgitem (hwindow,104),1)
    enablewindow (getdlgitem (hwindow,105),1)
    sl.areacode = ""
    sl.number = ""
  end if
end function

'---------------------------------------------------------------------------=[ Subroutines  ]=-
sub phonesearch.init
  dim t as tabrecord, result1 as integer
  t.tabs(1) =  60
  t.tabs(2) =  140
  t.tabs(3) =  160
  result1 = SendDlgItemMessageTab (HWindow, 507, LB_SETTABSTOPS, 3, t)
end sub

sub Generator.init
  userid   = ""
  password = ""
  areacode = ""
  number   = ""
  for count = 1 to getmodemcount
    addcomboboxitem (hwindow,106,getmodemname (count - 1))
  next count
  modem = 0
  addcomboboxitem (hwindow,107,"CompuServe Network")
  addcomboboxitem (hwindow,107,"SprintNet")
  addcomboboxitem (hwindow,107,"Tymnet")
  addcomboboxitem (hwindow,107,"Canadian Datapac")
  addcomboboxitem (hwindow,107,"LATA")
  addcomboboxitem (hwindow,107,"Telnet Services")
  service = 0
  if getfirstcountry (cinfo) then
    do
      readstring = pad (cinfo.name,150)+pad(str(cinfo.countryid),5)+pad(str(cinfo.countrycode),5)
      addcomboboxitem (hwindow,105,readstring)
    loop until not (getnextcountry (cinfo))
  end if
end sub

sub CreateCISCPSScript
  print #1, "striphibit on"
  print #1, "delay 1"
  print #1, "send ""^C"";"
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

sub CreateCISTELScript
  print #1, "striphibit on"
  print #1, "when match ""Host Name:"" do send ""CIS"""
  print #1, "when match ""Terminal"" do send ""D1^M"""
  print #1, "delay 1"
  print #1, "send ""@.^M"""
  print #1, "delay 2"
  print #1, "timeout 5"
  print #1, "try1200:"
  print #1, "waitfor ""TERMINAL="""
  print #1, "timeout off"
  print #1, "waitfor ""@"""
  print #1, "send ""C 202202"""
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
  print #1,
  print #1, "catch err_timeout"
  print #1, "send ""^M.^M"""
  print #1, "goto try1200"
end sub

sub CreateCISTYMScript
  print #1, "striphibit on"
  print #1, "when match ""Host Name:"" do send ""CIS"""
  print #1, "delay 2"
  print #1, "send ""A"";"
  print #1, "waitfor ""LOG IN"""
  print #1, "send ""CML05"""
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

sub CreateCISDPCScript
  print #1, "striphibit on"
  print #1, "when match ""Host Name:"" do send ""CIS"""
  print #1, "delay 2"
  print #1, "send ""..."""
  print #1, "waitfor ""datapac"""
  print #1, "send ""29400138"""
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

sub CreateCISLATScript
  print #1, "striphibit on"
  print #1, "when match ""Host Name:"" do send ""CIS"""
  print #1, "delay 2"
  print #1, "send ""...^M"""
  print #1, "waitfor ""public data"""
  print #1, "send "".CPS^M"""
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

sub CreateCISTELNETScript
  print #1, "striphibit on"
  print #1, "waitfor ""Host Name:"""
  print #1, "send ""cis^M"""
  print #1, "waitfor ""Enter choice (LOGON, HELP, OFF):"""
  print #1, "send ""logon^M"""
  print #1, "waitfor ""Enter choice (300, 2400, 9600, 14400, OFF):"""
  print #1, "send ""14400^M"""
  print #1, "waitfor ""User ID: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

'---------------------------------------------------------------------------=[ Main         ]=-
MAIN:

if dialogbox(sl) = IDOK then
  scriptname = GetUniqueScriptName("cis")
  dim entry as phoneentry
  open scriptname for output as #1
  select case sl.service
    case 0
      CreateCISCPSScript
      entry.name = "Compuserve"
      entry.emulation = vt100
    case 1
      CreateCISTELScript
      entry.name = "Compuserve via SprintNet"
      entry.emulation = vt100
    case 2
      CreateCISTYMScript
      entry.name = "Compuserve via TymNet"
      entry.emulation = vidtex
    case 3
      CreateCISDPCScript
      entry.name = "Compuserve via Canadian Datapac"
      entry.emulation = vidtex
    case 4
      CreateCISLATScript
      entry.name = "Compuserve via LATA"
      entry.emulation = vidtex
    case 5
      CreateCISTELNETScript
      entry.name = "Compuserve via TELNET"
      entry.emulation = vidtex
  end select
  close #1
  if (sl.service = 5) then
    entry.useareacountry = 0
    entry.connecttype = 2
  else
    entry.useareacountry = 1
    entry.connecttype = 0
  end if
  entry.areacode = sl.areacode
  entry.number(1) = sl.number
  entry.userid = sl.userid
  entry.password = sl.password
  entry.scriptfile = scriptname
  entry.macrofile = "cis.mac"
  entry.protocol = bplus
  entry.tapidevice = getmodemname (sl.modem)
  entry.countryid   = val(mid(n,151,5))
  entry.countrycode = val(mid(n,156,5))
  entry.iconrespath = "bbsicons.dll"
  entry.iconresid = 2
  if updatephoneentry (entry) then
    msgbox ("Compuserve Entry Modified With New Information")
  else
    addphoneentry (entry)
    msgbox "Phone directory entry for CompuServe created."
  end if
end if

catch err_fileopen
  msgbox "Could not create script: " + scriptname
  goto main